home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 56 / 64er_Magazin_Sonderheft_56_19xx_Markt__Technik_de_Side_B.d64 / matrix 2.6 (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  15KB  |  698 lines
  1. 100 rem   *****************************
  2. 110 rem   * v 2.6                     *
  3. 120 rem   * matrix rechner mit editor *
  4. 130 rem   *                           *
  5. 140 rem   *  (c)1988 viktor k.andor   *
  6. 150 rem   *                           *
  7. 160 rem   *   eduard moerike-str.6    *
  8. 170 rem   *   2970 emden tel:44736    *
  9. 180 rem   *                           *
  10. 190 rem   *****************************
  11. 200 :
  12. 210 :
  13. 220 poke 55,226:poke 56,159:clr:poke 788,52
  14. 230 for i=0 to 25:read x:poke 40931+i,x:next i
  15. 240 data 032,253,174,032,158,183,138,072
  16. 250 data 032,253,174,032,158,183,104,168
  17. 260 data 024,032,240,255,032,253,174,076
  18. 270 data 164,170
  19. 280 at=40931
  20. 290 deffne(y)=int(1e7*y+.5)/1e7
  21. 300 for i=0 to 42:read a:poke 24576+i,a:next i
  22. 310 data 169,000,160,004,133,250,132,251
  23. 320 data 169,232,160,007,133,252,132,253
  24. 330 data 169,160,133,254,160,000,165,254
  25. 340 data 145,250,230,250,208,002,230,251
  26. 350 data 165,250,197,252,165,251,229,253
  27. 360 data 144,230,096
  28. 370 poke 53280,11:poke 53281,0:poke 53265,11:print"[129][147]":sys 24576
  29. 380 b1$="[146][159][221] [221] [221] [221] [221] [221] [221] [221] [221] [221] [221]"
  30. 390 b2$="[146][159][171][192][219][192][219][192][219][192][219][192][219][192][219][192][219][192][219][192][219][192][179]"
  31. 400 b0$="[129]":b3$="":b4$="[158]":b5$="":b6$="[154]":b8$="+ - * /?"
  32. 410 b9$="q   x ?  y?"
  33. 420 f1$="0102030405060708091011121314151617181920"
  34. 430 v1$="0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 2 "
  35. 440 v2$="1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 "
  36. 450 printb0$"    0 0 0 0 0 0 0 0 0 1  viktor k.andor"
  37. 460 printb0$"    1 2 3 4 5 6 7 8 9 0       1988"
  38. 470 printb0$"   [146][159][176][192][178][192][178][192][178][192][178][192][178][192][178][192][178][192][178][192][178][192][174]"
  39. 480 printb0$" 01";b1$
  40. 490 printb0$"   ";b2$
  41. 500 printb0$" 02";b1$
  42. 510 printb0$"   ";b2$
  43. 520 printb0$" 03";b1$
  44. 530 printb0$"   ";b2$
  45. 540 printb0$" 04";b1$
  46. 550 printb0$"   ";b2$
  47. 560 printb0$" 05";b1$
  48. 570 printb0$"   ";b2$
  49. 580 printb0$" 06";b1$
  50. 590 printb0$"   ";b2$
  51. 600 printb0$" 07";b1$
  52. 610 printb0$"   ";b2$
  53. 620 printb0$" 08";b1$
  54. 630 printb0$"   ";b2$
  55. 640 printb0$" 09";b1$
  56. 650 printb0$"   ";b2$
  57. 660 printb0$" 10";b1$
  58. 670 printb0$"   [146][159][173][192][177][192][177][192][177][192][177][192][177][192][177][192][177][192][177][192][177][192][189]"
  59. 680 gosub 6860
  60. 690 for i=4 to 21 step 2:sys at,26,i,b3$"            ":next i
  61. 700 print"[159]"
  62. 710 sys at,25,02,"[176][192][192][192][192][192][192][192][192][192][192][192][192][174]"
  63. 720 sys at,25,22,"[173][192][192][192][192][192][192][192][192][192][192][192][192][189]"
  64. 730 gosub 6860
  65. 740 for i=4 to 21 step 2:sys at,26,i,b3$"            ":next i
  66. 750 print"[159]"
  67. 760 for i=3 to 21 :sys at,25,i,"[221]":sys at,38,i,"[221]":next i:poke 53265,27
  68. 770 dim z(1,20,20),c(20,20),m(1,20,20),w(20):ma=0:tr=1
  69. 780 get a$:if a$=""then 780
  70. 790 if a$="i" then 1060
  71. 800 if a$="c" then 1950
  72. 810 if a$="d" then 2220
  73. 820 if a$="e" then gosub 6970:goto 910
  74. 830 if a$="q" then cl=0:gosub 6770
  75. 840 if a$="m" then 2860
  76. 850 if a$="r" then 2970
  77. 860 if a$="s" then 3100
  78. 870 if a$="w" then 3240
  79. 880 if a$="-" then 3600
  80. 890 goto 780
  81. 900 :
  82. 910 get a$:if a$=""then 910
  83. 920 if a$="+" then 3700
  84. 930 if a$="-" then 3830
  85. 940 if a$="*" then 3960
  86. 950 if a$="/" then 4290
  87. 960 if a$="q" then gosub 6860:k=0:goto 780
  88. 970 if a$="i" then 4200
  89. 980 if a$="d" then 4070
  90. 990 if a$="t" then 5550
  91. 1000 if a$="s"then 5710
  92. 1010 if a$="_"then 3350
  93. 1020 goto 910
  94. 1030 :
  95. 1040 rem input
  96. 1050 :
  97. 1060 sys at,26,3,b3$;b9$:o=5
  98. 1070 get a$:if a$=""then 1070
  99. 1080 if a$="x" then 1150
  100. 1090 if a$="y" then 1290
  101. 1100 if a$="q" then 1400
  102. 1110 goto 1070
  103. 1120 :
  104. 1130 rem input x
  105. 1140 :
  106. 1150 gosub 6410
  107. 1160 sys at,26,3,b3$"    "b4$"matrix x":sys at,1,0,"x"
  108. 1170 gosub 1430:gosub 1490:gosub 6550
  109. 1180 mx=val(m$):f=mx
  110. 1190 gosub 1440:gosub 1490:gosub 6550
  111. 1200 nx=val(m$):v=nx
  112. 1210 gosub 1460
  113. 1220 if w=1 then 1170
  114. 1230 kx=mx:ky=nx:p=mx:r=nx
  115. 1240 da=ma
  116. 1250 goto 1390
  117. 1260 :
  118. 1270 rem input y
  119. 1280 :
  120. 1290 gosub 6410
  121. 1300 sys at,26,3,b3$"    "b4$"matrix y":sys at,1,0,"y"
  122. 1310 gosub 1430:gosub 1490:gosub 6550
  123. 1320 my=val(m$):f=my
  124. 1330 gosub 1440:gosub 1490:gosub 6550
  125. 1340 ny=val(m$):v=ny
  126. 1350 gosub 1460
  127. 1360 if w=1 then 1310
  128. 1370 kx=my:ky=ny:p=my:r=ny
  129. 1380 da=tr
  130. 1390 xy=5:gosub 6460:gosub 6550:gosub 5360
  131. 1400 sys at,26,3,b3$"i = matrix  "
  132. 1410 goto 780
  133. 1420 :
  134. 1430 sys at,3,23,b0$"m=?":sa=2:return
  135. 1440 sys at,3,23,b0$"n=?":sa=2:return
  136. 1450 :
  137. 1460 if f>20 or v>20 or f<1 or v<1 then gosub 6370:w=1:return
  138. 1470 w=0:return
  139. 1480 :
  140. 1490 m$="":sz=0
  141. 1500 get n$:if n$=""then 1500
  142. 1510 if asc(n$)=13 then return
  143. 1520 if asc(n$)=20 and sz>=1 then sz=sz-1:m$=left$(m$,sz):goto 1570
  144. 1530 if asc(n$)=69 or asc(n$)=45 or asc(n$)=46 then 1550
  145. 1540 if asc(n$)>57 or asc(n$)<48 then 1500
  146. 1550 m$=m$+n$:sz=sz+1
  147. 1560 if sz>sa then sz=sa:m$=left$(m$,sz)
  148. 1570 gosub 1610
  149. 1580 sys at,o,23,b0$;m$
  150. 1590 goto 1500
  151. 1600 :
  152. 1610 sys at,o,23,b0$"                "
  153. 1620 return
  154. 1630 :
  155. 1640 if f1>3  and y<=10 then gosub 1760:y=y-1:f1=f1-2:goto 2560
  156. 1650 if f1>3  and y>1   then y=y-1:y1=y-10:gosub 1800:goto 2560
  157. 1660 goto 2600
  158. 1670 if f1<21 and y<f   then gosub 1760:y=y+1:f1=f1+2:goto 2560
  159. 1680 if f>10  and y<f   then gosub 1790:y=y+1:goto 2560
  160. 1690 goto 2600
  161. 1700 if v1>4  and x<=10 then gosub 1760:x=x-1:v1=v1-2:goto 2560
  162. 1710 if v1>4  and x>1   then x=x-1:gosub 1840:goto 2560
  163. 1720 goto 2600
  164. 1730 if v1<22 and x<v   then gosub 1760:x=x+1:v1=v1+2:goto 2560
  165. 1740 if v>10  and x<v   then x=x+1:gosub 1840:goto 2560
  166. 1750 goto 2600
  167. 1760 if abs(z(da,y,x))>1e-5 then sys at,v1,f1,b5$" ":return
  168. 1770 sys at,v1,f1,b4$" ":return
  169. 1780 :
  170. 1790 y1=y-9
  171. 1800 for i=3 to 21 step 2
  172. 1810 sys at,1,i,b0$;mid$(f1$,y1*2+1,2):y1=y1+1:next i
  173. 1820 return
  174. 1830 :
  175. 1840 if x<=10 then 1890
  176. 1850 sys at,4,0,b0$;mid$(v1$,x*2-19,19)
  177. 1860 sys at,4,1,b0$;mid$(v2$,x*2-19,19)
  178. 1870 return
  179. 1880 :
  180. 1890 sys at,4,0,b0$;mid$(v1$,1,19)
  181. 1900 sys at,4,1,b0$;mid$(v2$,1,19)
  182. 1910 return
  183. 1920 :
  184. 1930 rem clear
  185. 1940 :
  186. 1950 sys at,26,7,b3$;b9$
  187. 1960 get a$:if a$=""then 1960
  188. 1970 if a$="x" then 2040
  189. 1980 if a$="y" then 2140
  190. 1990 if a$="q" then 2090
  191. 2000 goto 1960
  192. 2010 :
  193. 2020 rem clear x
  194. 2030 :
  195. 2040 if mx=0 then f$="x":gosub 6580:goto 2090
  196. 2050 sys at,26,7,b3$"    "b4$"clear x"
  197. 2060 cl=1:gosub 6770:if a$="n" then 2090
  198. 2070 kx=mx:ky=nx:xy=5:da=ma:p=mx:r=nx:gosub 5360
  199. 2080 gosub 6410
  200. 2090 sys at,26,7,b3$"c = clear  "
  201. 2100 goto 780
  202. 2110 :
  203. 2120 rem clear y
  204. 2130 :
  205. 2140 if my=0 then f$="y":gosub 6580:goto 2090
  206. 2150 sys at,26,7,b3$"    "b4$"clear y"
  207. 2160 cl=1:gosub 6770:if a$="n" then 2190
  208. 2170 kx=my:ky=ny:xy=5:da=tr:p=my:r=ny:gosub 5360
  209. 2180 gosub 6410
  210. 2190 goto 2090
  211. 2200 :
  212. 2210 rem daten eingabe
  213. 2220 :
  214. 2230 sys at,26,5,b3$;b9$:o=5
  215. 2240 get a$:if a$=""then 2240
  216. 2250 if a$="x" then 2320
  217. 2260 if a$="y" then 2420
  218. 2270 if a$="q" then 2370
  219. 2280 goto 2240
  220. 2290 :
  221. 2300 rem data x
  222. 2310 :
  223. 2320 if mx=0 then f$="x":gosub 6580:goto 2370
  224. 2330 sys at,26,5,b3$"    "b4$"data x ":sys at,1,0,"x"
  225. 2340 kx=mx:ky=nx:gosub 6410:gosub 6460
  226. 2350 f=mx:v=nx
  227. 2360 da=ma:gosub 2500
  228. 2370 sys at,26,5,b3$"d = data    "
  229. 2380 goto 780
  230. 2390 :
  231. 2400 rem data y
  232. 2410 :
  233. 2420 if my=0 then f$="y":gosub 6580:goto 2370
  234. 2430 sys at,26,5,b3$"    "b4$"data y ":sys at,1,0,"y"
  235. 2440 f=my:v=ny:kx=my:ky=ny:gosub 6410:gosub 6460
  236. 2450 da=tr:gosub 2500
  237. 2460 sys at,26,5,b3$"d = data    "
  238. 2470 if mx<>0 then f=mx:v=nx:kx=mx:ky=nx:gosub 6410:gosub 6460:sys at,1,0,"x"
  239. 2480 goto 780
  240. 2490 :
  241. 2500 f1=3:v1=4:sa=15
  242. 2510 gosub 1890
  243. 2520 y1=0:gosub 1800
  244. 2530 for y=1 to f
  245. 2540 for x=1 to v
  246. 2550 if x>=10 then v1=22:gosub 1840
  247. 2560 sys at,v1,f1,"?"
  248. 2570 gosub 1610
  249. 2580 m$=str$(fne(z(da,y,x)))
  250. 2590 sys at,3,23,b0$;"x=";m$
  251. 2600 get n$:if n$="" then 2600
  252. 2610 if asc(n$)=45 or asc(n$)=46 then 2630
  253. 2620 if asc(n$)<48 or asc(n$)>57 then 2650
  254. 2630 m$="":sz=0:gosub 1550:z(da,y,x)=val(m$)
  255. 2640 if asc(n$)= 13 then 2720
  256. 2650 if asc(n$)=147 or asc(n$)=19 then gosub 1890:goto 2800
  257. 2660 if asc(n$)=145 then 1640
  258. 2670 if asc(n$)= 17 then 1670
  259. 2680 if asc(n$)=157 then 1700
  260. 2690 if asc(n$)= 29 then 1730
  261. 2700 if asc(n$)= 13 then 2720
  262. 2710 goto  2600
  263. 2720 gosub 1760
  264. 2730 v1=v1+2
  265. 2740 next x
  266. 2750 gosub 1890
  267. 2760 v1=4
  268. 2770 f1=f1+2
  269. 2780 if y>=10 and y<f then f1=21:gosub 1790
  270. 2790 next y
  271. 2800 y1=0:gosub 1800
  272. 2810 gosub 6550:gosub 6460
  273. 2820 return
  274. 2830 :
  275. 2840 rem m=x
  276. 2850 :
  277. 2860 if mx=0 then f$="x":gosub 6580:goto 2920
  278. 2870 sys at,30,13,b4$"x   [192]>m"
  279. 2880 mm=mx:nm=nx
  280. 2890 for x=1 to mx
  281. 2900 for y=1 to nx
  282. 2910 m(0,x,y)=z(ma,x,y):next y:next x
  283. 2920 sys at,30,13,b3$"x   [192]>m"
  284. 2930 goto 780
  285. 2940 :
  286. 2950 rem x=m
  287. 2960 :
  288. 2970 if mm=0 then f$="m":gosub 6580:goto 3050
  289. 2980 sys at,30,15,b4$"m   [192]>x":sys at,1,0,"x"
  290. 2990 gosub 6410
  291. 3000 mx=mm:nx=nm
  292. 3010 kx=mm:ky=nm:gosub 6460
  293. 3020 for x=1 to mm
  294. 3030 for y=1 to nm
  295. 3040 z(ma,x,y)=m(0,x,y):next y:next x
  296. 3050 sys at,30,15,b3$"m   [192]>x"
  297. 3060 goto 780
  298. 3070 :
  299. 3080 rem x=x+m
  300. 3090 :
  301. 3100 if mm=0 then f$="m":gosub 6580:goto 3190
  302. 3110 sys at,30,17,b4$"x+m [192]>m":sys at,1,0,"x"
  303. 3120 if mm=mx or nm=nx then 3140
  304. 3130 gosub 6620:goto 3190
  305. 3140 for x=1 to mm
  306. 3150 for y=1 to nm
  307. 3160 m(0,x,y)=m(0,x,y)+z(ma,x,y)
  308. 3170 next y
  309. 3180 next x
  310. 3190 sys at,30,17,b3$"x+m [192]>m"
  311. 3200 goto 780
  312. 3210 :
  313. 3220 rem vertauschen von x,y
  314. 3230 :
  315. 3240 if mx=0 and my=0 then f$="":gosub 6580:goto 3300
  316. 3250 sys at,30,19,b4$"x< [192] >y":sys at,1,0,"x"
  317. 3260 c=ma:ma=tr:tr=c
  318. 3270 c=mx:mx=my:my=c:c=nx:nx=ny:ny=c
  319. 3280 kx=mx:ky=nx:gosub 6410
  320. 3290 if mx<>0 then gosub 6460
  321. 3300 sys at,30,19,b3$"x< [192] >y"
  322. 3310 goto 780
  323. 3320 :
  324. 3330 rem drehen
  325. 3340 :
  326. 3350 if mx=0 then f$="x":gosub 6580:gosub 6860:goto 780
  327. 3360 sys at,26,21,b3$"q   _ ?  ^?"
  328. 3370 get a$:if a$="" then 3370
  329. 3380 if a$="_" then sys at,26,21,b3$"    "b4$"_"b3$"       ":goto 3420
  330. 3390 if a$="^" then sys at,26,21,b3$"         "b4$"^"b3$"  ":goto 3460
  331. 3400 if a$="q" then 3550
  332. 3410 goto 3370
  333. 3420 if mx<>nx then gosub 6530:gosub 6740:goto 3550
  334. 3430 g=mx
  335. 3440 for x=1 to mx:for y=1 to mx:c(x,y)=z(ma,x,y):next y:next x
  336. 3450 for x=1 to mx:for y=1 to mx:z(ma,x,y)=c(y,g):next y:g=g-1:next x
  337. 3460 gosub 3470:goto 3550
  338. 3470 kx=mx:ky=nx:x=1:y=1
  339. 3480 if kx>10 then kx=10
  340. 3490 if ky>10 then ky=10
  341. 3500 for f1=3 to 2+2*kx step 2
  342. 3510 for v1=4 to 3+2*ky step 2
  343. 3520 if abs(z(ma,x,y))>1e-5 then sys at,v1,f1,b5$" ":goto 3540
  344. 3530 sys at,v1,f1,b4$" "
  345. 3540 y=y+1:next v1:y=1:x=x+1:next f1:return
  346. 3550 sys at,26,21,b3$"_ = drehen x"
  347. 3560 goto 910
  348. 3570 :
  349. 3580 rem vertauschen der vorzeichen
  350. 3590 :
  351. 3600 if mx=0 then f$="x":gosub 6580:goto 3650
  352. 3610 sys at,30,21,b4$"+/- [192]>x"
  353. 3620 for x=1 to mx
  354. 3630 for y=1 to nx
  355. 3640 z(ma,x,y)=z(ma,x,y)*-1:next y:next x
  356. 3650 sys at,30,21,b3$"+/- [192]>x"
  357. 3660 goto 780
  358. 3670 :
  359. 3680 rem x=x+y
  360. 3690 :
  361. 3700 if mx=0 or my=0 then f$="x oder y":gosub 6580:gosub 6860:goto 780
  362. 3710 if mx<>my or nx<>ny then gosub 6530:gosub 6620:goto 3780
  363. 3720 sys at,30,3,b4$"x+y  [192]>x":sys at,1,0,"x"
  364. 3730 for x=1 to mx
  365. 3740 for y=1 to nx
  366. 3750 z(ma,x,y)=z(ma,x,y)+z(tr,x,y)
  367. 3760 next y
  368. 3770 next x
  369. 3780 sys at,30,3,b3$"x+y  [192]>x"
  370. 3790 goto 910
  371. 3800 :
  372. 3810 rem x=x-y
  373. 3820 :
  374. 3830 if mx=0 or my=0 then f$="x oder y":gosub 6580:gosub 6860:goto 780
  375. 3840 if mx<>my or nx<>ny then gosub 6530:gosub 6620:goto 3910
  376. 3850 sys at,30,5,b4$"x-y  [192]>x":sys at,1,0,"x"
  377. 3860 for x=1 to mx
  378. 3870 for y=1 to nx
  379. 3880 z(ma,x,y)=z(ma,x,y)-z(tr,x,y)
  380. 3890 next y
  381. 3900 next x
  382. 3910 sys at,30,5,b3$"x-y  [192]>x"
  383. 3920 goto 910
  384. 3930 :
  385. 3940 rem x=x*y
  386. 3950 :
  387. 3960 if mx=0 or my=0 then f$="x oder y":gosub 6580:gosub 6860:goto 780
  388. 3970 sys at,30,7,b4$"x*y  [192]>x"
  389. 3980 gosub 6240
  390. 3990 gosub 6410
  391. 4000 k=k+1:if k=2 then k=0:gosub 6860:gosub 3470:goto 2350
  392. 4010 kx=mx:ky=nx:gosub 6460
  393. 4020 sys at,30,7,b3$"x*y  [192]>x":sys at,1,0,"x":k=0
  394. 4030 goto 910
  395. 4040 :
  396. 4050 rem determinante
  397. 4060 :
  398. 4070 if mx=0 then f$="x":gosub 6580:gosub 6860:goto 780
  399. 4080 if mx<>nx then gosub 6530:gosub 6740:goto 910
  400. 4090 sys at,30,17,b4$"determ.x"
  401. 4100 if mx=1 and nx=1 then de=z(ma,1,1):goto 4120
  402. 4110 xy=1:p=mx:r=nx:gosub 6030
  403. 4120 sys at,3,23,b0$"determinante=";de
  404. 4130 sys at,30,17,b3$"determ.x"
  405. 4140 get a$:if a$="" then 4140
  406. 4150 gosub 6550
  407. 4160 goto 920
  408. 4170 :
  409. 4180 rem reziprokwert von x
  410. 4190 :
  411. 4200 if mx=0 then f$="x":gosub 6580:gosub 6860:goto 780
  412. 4210 if mx<>nx then gosub 6530:gosub 6740:goto 910
  413. 4220 sys at,30,13,b4$"invers x":sys at,1,0,"x"
  414. 4230 xy=1:da=ma:in=mx:p=mx:r=nx:gosub 4740
  415. 4240 sys at,30,13,b3$"invers x":sys at,1,0,"x"
  416. 4250 goto 910
  417. 4260 :
  418. 4270 rem x=x/y
  419. 4280 :
  420. 4290 if mx=0 or my=0 then f$="x oder y":gosub 6580:gosub 6860:goto 780
  421. 4300 if my<>ny then gosub 6530:gosub 6740:goto 4420
  422. 4310 if nx<>ny then gosub 6530:gosub 6620:goto 4420
  423. 4320 sys at,30,9,b4$"x*iy ->x"
  424. 4330 :
  425. 4340 xy=2:da=tr:in=my:p=my:r=ny
  426. 4350 for x=1 to my:for y=1 to ny:m(1,x,y)=z(tr,x,y):next y:next x
  427. 4360 gosub 4740
  428. 4370 gosub 6240
  429. 4380 p=my:r=ny
  430. 4390 for x=1 to my:for y=1 to ny:z(tr,x,y)=m(1,x,y):next y:next x
  431. 4400 gosub 6410
  432. 4410 kx=mx:ky=nx:gosub 6460
  433. 4420 sys at,30,9,b3$"x*iy ->x":sys at,1,0,"x"
  434. 4430 goto 910
  435. 4440 :
  436. 4450 rem subrutin zum reziprokwert
  437. 4460 :
  438. 4470 k=1:for x=1 to cx
  439. 4480 c(x,x)=c(x,x)+1
  440. 4490 next x
  441. 4500 b=cx
  442. 4510 h=b
  443. 4520 d=c(h,h)-1
  444. 4530 if d=0 then k=0:return
  445. 4540 gosub 4620
  446. 4550 b=b-1
  447. 4560 if b>0 then 4510
  448. 4570 for x=1 to cx
  449. 4580 c(x,x)=c(x,x)-1
  450. 4590 next x
  451. 4600 return
  452. 4610 :
  453. 4620 for f=1 to cx
  454. 4630 h=b
  455. 4640 c(h,f)=c(h,f)/d
  456. 4650 next f
  457. 4660 for e=1 to cx
  458. 4670 if b=e then 4720
  459. 4680 h=b:d=c(e,b)
  460. 4690 for f=1 to cx
  461. 4700 c(e,f)=c(e,f)-d*c(b,f)
  462. 4710 next f
  463. 4720 next e:return
  464. 4730 :
  465. 4740 w=0:cx=in:dr=0:gosub 5360:if in=1 then gosub 4470:goto 4960
  466. 4750 for i=in-1 to 2 step-1
  467. 4760 if c(i,i)=0 or abs(c(i,i))<abs(c(i-1,i))then 4790
  468. 4770 next i
  469. 4780 goto 4800
  470. 4790 dr=1:gosub 5410
  471. 4800 for x=0 to in-1:w(x)=0:next x
  472. 4810 if c(1 , 1)=0 then gosub 4990
  473. 4820 if c(in,in)=0 then gosub 5080
  474. 4830 if in>2 then gosub 5220
  475. 4840 gosub 4470
  476. 4850 if k=0 then gosub 6830:return
  477. 4860 if in<3 then 4930
  478. 4870 for i=2 to in-1
  479. 4880 for x=1 to in
  480. 4890 if w(i)=0 then 4910
  481. 4900 c=c(x,w(i)):c(x,w(i))=c(x,i):c(x,i)=c
  482. 4910 next x
  483. 4920 next i
  484. 4930 if w(1)<>0 then pv=1:w=in:gosub 5170
  485. 4940 if w(0)<>0 then pv=0:w=1:gosub 5170
  486. 4950 if dr<>0 then gosub 5410
  487. 4960 xy=xy+2:gosub 5360:xy=xy-2
  488. 4970 return
  489. 4980 :
  490. 4990 for x=1 to in
  491. 5000 if c(1,x)=0 then 5020
  492. 5010 w(0)=x:goto 5030
  493. 5020 next x
  494. 5030 for x=1 to in
  495. 5040 c=c(x,w(0)):c(x,w(0))=c(x,1):c(x,1)=c
  496. 5050 next x
  497. 5060 return
  498. 5070 :
  499. 5080 for x=in to 1 step-1
  500. 5090 if c(in,x)=0then 5110
  501. 5100 w(1)=x:goto 5120
  502. 5110 next x
  503. 5120 for x=1 to in
  504. 5130 c=c(x,w(1)):c(x,w(1))=c(x,in):c(x,in)=c
  505. 5140 next x
  506. 5150 return
  507. 5160 :
  508. 5170 for x=1 to in
  509. 5180 c=c(w(pv),x):c(w(pv),x)=c(w,x):c(w,x)=c
  510. 5190 next x
  511. 5200 return
  512. 5210 :
  513. 5220 for i=in-1 to 2 step-1
  514. 5230 if c(i,i)=0 or abs(c(i,i))<abs(c(i-1,i)) then 5250
  515. 5240 goto 5330
  516. 5250 for x=i-1 to 1 step-1
  517. 5260 if c(x,i)=0 or abs(c(x,i))<abs(c(x+1,i)) then 5320
  518. 5270 w(i)=x
  519. 5280 for y=1 to in
  520. 5290 c=c(x,y):c(x,y)=c(i,y):c(i,y)=c
  521. 5300 next y
  522. 5310 x=1
  523. 5320 next x
  524. 5330 next i
  525. 5340 return
  526. 5350 :
  527. 5360 for x=1 to p:for y=1 to r
  528. 5370 on xy gosub 5470,5480,5490,5500,5510
  529. 5380 next y:next x
  530. 5390 return
  531. 5400 :
  532. 5410 g=in:for x=1 to in:for y=1 to in
  533. 5420 z(da,x,y)=c(y,g)
  534. 5430 next y:g=g-1:next x
  535. 5440 gosub 5360
  536. 5450 return
  537. 5460 :
  538. 5470 c(x,y)=z(ma,x,y):return
  539. 5480 c(x,y)=z(tr,x,y):return
  540. 5490 z(ma,x,y)=c(x,y):return
  541. 5500 z(tr,x,y)=c(x,y):return
  542. 5510 z(da,x,y)=0:return
  543. 5520 :
  544. 5530 rem transposition
  545. 5540 :
  546. 5550 if mx=0 then f$="x":gosub 6580:gosub 6860:goto 780
  547. 5560 sys at,30,15,b4$"transp.x"
  548. 5570 xy=1:p=mx:r=nx:gosub 5360
  549. 5580 for x=1 to mx
  550. 5590 for y=1 to nx
  551. 5600 z(ma,y,x)=c(x,y)
  552. 5610 next y
  553. 5620 next x
  554. 5630 c=mx:mx=nx:nx=c
  555. 5640 gosub 6410
  556. 5650 kx=mx:ky=nx:gosub 6460
  557. 5660 sys at,30,15,b3$"transp.x":sys at,1,0,"x"
  558. 5670 goto 910
  559. 5680 :
  560. 5690 rem skalar operation
  561. 5700 :
  562. 5710 if mx=0 then f$="x":gosub6580:gosub6860:goto 780
  563. 5720 sys at,26,19,b3$"q   ";b8$
  564. 5730 get a$:if a$="" then 5730
  565. 5740 if a$="+"then u=1:w=1:goto 5810
  566. 5750 if a$="-"then u=2:w=3:goto 5810
  567. 5760 if a$="*"then u=3:w=5:goto 5810
  568. 5770 if a$="/"then u=3:goto 5860
  569. 5780 if a$="q"then goto 5980
  570. 5790 goto 5730
  571. 5800 :
  572. 5810 sys at,29+w,19,b4$;mid$(b8$,w,1):gosub 5910
  573. 5820 for x=1 to mx:for y=1 to nx
  574. 5830 on u gosub 5950,5960,5970
  575. 5840 next y:next x
  576. 5850 goto 5980
  577. 5860 sys at,36,19,b4$"/":gosub 5910
  578. 5870 xy=1:da=ma:in=mx:p=mx:r=nx
  579. 5880 gosub 4740
  580. 5890 goto 5820
  581. 5900 :
  582. 5910 sys at,3,23,b0$"skalar=":sa=15:o=10:gosub 1490
  583. 5920 n=val(m$)
  584. 5930 gosub 6550:return
  585. 5940 :
  586. 5950 z(ma,x,y)=n+z(ma,x,y):return
  587. 5960 z(ma,x,y)=n-z(ma,x,y):return
  588. 5970 z(ma,x,y)=n*z(ma,x,y):return
  589. 5980 sys at,26,19,b3$"s = skalar x"
  590. 5990 goto 910
  591. 6000 :
  592. 6010 rem subrutin zur determinante
  593. 6020 :
  594. 6030 gosub 5360
  595. 6040 k=0:b=p:e=1
  596. 6050 i=b
  597. 6060 d=c(i,i):if d=0 then gosub 6110
  598. 6070 if k=1 then e=0:goto 6100
  599. 6080 e=d*e:gosub 6180
  600. 6090 b=b-1:if b>1 then 6050
  601. 6100 e=e*c(1,1):de=e:return
  602. 6110 for f=1 to b-1
  603. 6120 d=c(f,i):if d<>0 then 6160
  604. 6130 next f
  605. 6140 k=1
  606. 6150 return
  607. 6160 for g=1 to b:c(i,g)=c(i,g)+c(f,g):next g
  608. 6170 return
  609. 6180 for f=1 to b-1:l=c(f,i)/d:for g=1 to b-1:c(f,g)=c(f,g)-l*c(i,g)
  610. 6190 next g:next f
  611. 6200 return
  612. 6210 :
  613. 6220 rem subrutin zum produkt
  614. 6230 :
  615. 6240 if nx<>my then gosub 6530:gosub 6670:return
  616. 6250 for x=1 to mx
  617. 6260 for y=1 to ny
  618. 6270 c(x,y)=0
  619. 6280 for z=1 to nx
  620. 6290 c(x,y)=c(x,y)+z(ma,x,z)*z(tr,z,y)
  621. 6300 next z
  622. 6310 next y
  623. 6320 next x
  624. 6330 xy=3:p=mx:r=ny:gosub 5360
  625. 6340 nx=ny
  626. 6350 return
  627. 6360 :
  628. 6370 gosub 6530
  629. 6380 sys at,3,23,b0$"definition 1-20"
  630. 6390 goto 6540
  631. 6400 :
  632. 6410 for y=3 to 2+2*10 step 2
  633. 6420 for x=4 to 3+2*10 step 2
  634. 6430 sys at,x,y," ":next x:next y
  635. 6440 return
  636. 6450 :
  637. 6460 if kx>10 then kx=10
  638. 6470 if ky>10 then ky=10
  639. 6480 for y=3 to 2+2*kx step 2
  640. 6490 for x=4 to 3+2*ky step 2
  641. 6500 sys at,x,y,b6$" ":next x:next y
  642. 6510 return
  643. 6520 :
  644. 6530 sys at,3,23,b0$"error !!         "
  645. 6540 for i=1 to 2000:next i
  646. 6550 sys at,3,23,b0$"                                   "
  647. 6560 return
  648. 6570 :
  649. 6580 sys at,3,23,b0$"keine definition in matrix ";f$
  650. 6590 gosub 6540
  651. 6600 return
  652. 6610 :
  653. 6620 sys at,3,23,b0$"matrizen verschiedenen formats"
  654. 6630 gosub 6540
  655. 6640 return
  656. 6650 :
  657. 6660 gosub 6530
  658. 6670 sys at,3,23,b0$"(n) in matrix x und (m) in matrix y":for i=1 to 900:next i
  659. 6680 gosub 6540
  660. 6690 sys at,3,23,b0$"sind ungleich"
  661. 6700 gosub 6540
  662. 6710 return
  663. 6720 :
  664. 6730 gosub 6530
  665. 6740 sys at,3,23,b0$"matriz ist nicht quadratisch"
  666. 6750 goto 6700
  667. 6760 :
  668. 6770 sys at,3,23,b0$"sind sie sicher ? j/n"
  669. 6780 get a$:if a$=""then 6780
  670. 6790 if a$="j" and cl=0 then gosub 6550:poke 788,49:print"[145][145][145]":end
  671. 6800 if a$="j" and cl=1 then gosub 6550:return
  672. 6810 if a$="n" then gosub 6550:return
  673. 6820 goto 6780
  674. 6830 sys at,3,23,b0$"matrix ist singulaer"
  675. 6840 goto 6700
  676. 6850 :
  677. 6860 sys at,26,3,b3$"i = matrix  "
  678. 6870 sys at,26,5,b3$"d = data    "
  679. 6880 sys at,26,7,b3$"c = clear   "
  680. 6890 sys at,26,9,b3$"e = menue ii"
  681. 6900 sys at,26,11,b3$"q = quit    "
  682. 6910 sys at,26,13,b3$"m = x   [192]>m "
  683. 6920 sys at,26,15,b3$"r = m   [192]>x "
  684. 6930 sys at,26,17,b3$"s = x+m [192]>m "
  685. 6940 sys at,26,19,b3$"w = x< [192] >y "
  686. 6950 sys at,26,21,b3$"- = +/- [192]>x "
  687. 6960 return
  688. 6970 sys at,26,3,b3$"+ = x+y  [192]>x"
  689. 6980 sys at,26,5,b3$"- = x-y  [192]>x"
  690. 6990 sys at,26,7,b3$"* = x*y  [192]>x"
  691. 7000 sys at,26,9,b3$"/ = x*iy [192]>x"
  692. 7010 sys at,26,13,b3$"i = invers x"
  693. 7020 sys at,26,15,b3$"t = transp.x"
  694. 7030 sys at,26,17,b3$"d = determ.x"
  695. 7040 sys at,26,19,b3$"s = skalar x"
  696. 7050 sys at,26,21,b3$"_ = drehen x"
  697. 7060 return
  698.